Caption = "Fin&d next entry containing string above"
Height = 330
Index = 4
Left = 165
TabIndex = 8
Top = 3480
Width = 3495
End
Begin TextBox txtFormName
Height = 330
Index = 1
Left = 165
TabIndex = 7
Top = 3060
Width = 3495
End
Begin CommandButton cmdHuh
BackColor = &H0080FFFF&
Caption = "?"
Height = 330
Left = 3345
TabIndex = 12
Top = 465
Width = 315
End
Begin CommandButton cmdFindForm
BackColor = &H0080FFFF&
Caption = "F&ind Index of Exact Filename Above"
Height = 330
Index = 1
Left = 165
TabIndex = 3
Top = 1305
Width = 3495
End
Begin CommandButton cmdFindForm
BackColor = &H0080FFFF&
Caption = "Fi&nd and Select Form Above"
Height = 330
Index = 3
Left = 165
TabIndex = 5
Top = 2145
Width = 3495
End
Begin CommandButton cmdFindForm
BackColor = &H0000FFFF&
Caption = "N&ame and Index of Current Selection..."
Height = 330
Index = 5
Left = 165
TabIndex = 9
Top = 4110
Width = 3495
End
Begin CommandButton cmdFindForm
BackColor = &H0080FFFF&
Caption = "&Select Form Above in Project Window"
Height = 330
Index = 2
Left = 165
TabIndex = 4
Top = 1725
Width = 3495
End
Begin CommandButton cmdFindForm
BackColor = &H0000FFFF&
Caption = "&List Files In Project"
Height = 330
Index = 6
Left = 165
TabIndex = 10
Top = 4530
Width = 3495
End
Begin CommandButton c3dExit
BackColor = &H0080FFFF&
Caption = "E&xit"
Height = 330
Left = 4425
TabIndex = 11
Top = 4530
Width = 1665
End
Begin TextBox txtFormName
Height = 330
Index = 0
Left = 165
TabIndex = 1
Top = 465
Width = 3135
End
Begin CommandButton cmdFindForm
BackColor = &H0080FFFF&
Caption = "&Find Index of Form Prefix Above"
Default = -1 'True
Height = 330
Index = 0
Left = 165
TabIndex = 2
Top = 885
Width = 3495
End
Begin Label Label1
BackColor = &H0080FFFF&
Caption = "En&ter a string to find in the list..."
Height = 225
Index = 1
Left = 165
TabIndex = 6
Top = 2790
Width = 3495
End
Begin Label Label1
BackColor = &H0080FFFF&
Caption = "&Enter a filename prefix to find in the list..."
Height = 225
Index = 0
Left = 165
TabIndex = 0
Top = 195
Width = 3735
End
'This project code
1994 David Stewart
'Project demonstrating the use of Windows List Box messages
'to derive and find FileNamePrefixs and strings in the Visual
'Basic Project window.
Option Explicit
DefInt A-Z
'Const NORMAL% = 0
'Const MINIMIZED% = 1
'Const MAXIMIZED% = 2
Const WM_USER = &H400
Const LB_FINDSTRING = (WM_USER + 16)
Const LB_FINDSTRINGEXACT = (WM_USER + 35)
Const LB_GETCOUNT = (WM_USER + 12)
Const LB_GETTEXT = (WM_USER + 10)
Const LB_GETTEXTLEN = (WM_USER + 11)
Const LB_SELECTSTRING = (WM_USER + 13)
Const LB_GETCURSEL = (WM_USER + 9)
Const LB_SETCURSEL = (WM_USER + 7)
' GetWindow() Constants
Const GW_HWNDFIRST = 0
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Const GW_HWNDPREV = 3
Const GW_OWNER = 4
Const GW_CHILD = 5
Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpCaption As Any)
'Declare Function GetActiveWindow Lib "User" () As Integer
Declare Function GetNextWindow Lib "User" (ByVal hWnd As Integer, ByVal wFlag As Integer) As Integer
Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
'Declare Sub HideCaret Lib "user" (ByVal hWnd As Integer)
'Declare Function IsIconic Lib "User" (ByVal hWnd As Integer) As Integer
'Declare Function IsZoomed Lib "User" (ByVal hWnd As Integer)
'Declare Sub MoveWindow Lib "User" (ByVal hWnd As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal bRepaint As Integer)
Declare Function SendMsgByStr& Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam$)
Declare Function SendMsgByNum& Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam&)
'Declare Sub SetActiveWindow Lib "User" (ByVal hWnd)
'Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
'Declare Sub ShowCaret Lib "user" (ByVal hWnd As Integer)
'Declare Function GetFocus Lib "User" () As Integer
Dim Msg$, DblSp$
Sub c3dExit_Click ()
Unload Me
End
End Sub
Sub cmdAbout_Click ()
Msg$ = "VB Project Spy List" & Chr(10)
Msg$ = Msg$ & "Copyright 1994 David Stewart" & DblSp
Msg$ = Msg$ & "VB Project Spy List demonstrates the "
Msg$ = Msg$ & "ability of Visual Basic applications "
Msg$ = Msg$ & "to read the filename contents of the VB "
If FrmListPos < 0 Then MsgBox "The file prefix entered above is not in the Project window's list box, so it cannot be selected.", 64, "Demo Copyright 1994 David Stewart"
Case 3 'Find and Select Form Above
'This does essentially the same thing as Case 2, but divides it into two steps.
'...ask user if he wants to select it in the list.
Response = MsgBox("The prefix entered above has been found in the Project window's list box. Do you want to select the form in the list box?", 36, "Demo Copyright 1994 David Stewart")
'Possible Response values: 6--YES, 7--NO.
'If yes, then select it and leave the sub.
If Response = 6 Then
i = SendMsgByStr(PROJECTListBox, LB_SETCURSEL, 0, FileNamePrefix)
Exit Sub
'If not, get out of the routine.
ElseIf Response = 7 Then
Exit Sub
End If
Else
'If the user entered a prefix that's not in any file in the list...
MsgBox "The file prefix entered above is not in the Project window's list box, so it cannot be selected.", 64, "Demo Copyright 1994 David Stewart"
End If
Case 4 'Find Next Entry Containing String Above
'This starts with the list entry below whatever one is
'currently selected, and looks for the string in
'its text box INSIDE the strings of list entries, until
If CurSelPos = EntriesCount - 1 Then CurSelPos = CurSelPos - 1
'If there are no items in the list, split.
If EntriesCount% = 0 Then
MsgBox "There are no files listed in the Project list box.", 64, "Demo Copyright 1994 David Stewart"
Exit Sub
Else
'Begin the search at the list entry below the
'current selection, go to last entry. We want this
'procedure to loop around to the beginning, though,
'so that we can find the entry if it is ABOVE the
'currently selected one or in case the currently selected
'one is the only entry that matches. We'll enter
'another For loop to do that when we reach
'the last index value of this one. There may be a more
'efficient way of doing this, but I couldn't think of it
'at the time.
For i = CurSelPos + 1 To (EntriesCount - 1) Step 1
'Get the length of the text in the current entry.
LenEntryText = SendMsgByNum(PROJECTListBox, LB_GETTEXTLEN, i, 0)
'Initialize a string to hold the text.
Buf = String$(LenEntryText + 1, 0)
'This will obtain the string, storing it in Buf, and return
'the length of the string.
BufLen = SendMsgByStr(PROJECTListBox, LB_GETTEXT, i, Buf)
'Search the Buf string for the string fragment the user's typed in...
IsStringIn = InStr(1, Buf, txtFormName(1).Text)
'If we find it, its starting point will be > 0.
If IsStringIn > 0 Then
'Let use know we've found it.
MsgBox "The string fragment '" & txtFormName(1).Text & "' has been found" & Chr(10) & "in index entry" & Str(i) & ", " & Left(Buf, LenEntryText) & ".", 64, "Demo Copyright 1994 David Stewart"
'Select the entry.
FrmListPos = SendMsgByNum(PROJECTListBox, LB_SETCURSEL, i, 0)
Exit For
Else
'If we get to the end of the list without having found our string...
If i = (EntriesCount - 1) Then
'...start another loop from the top of the list to the position
'of the selected item when we started the i loop. This way, we miss
MsgBox "The string fragment '" & txtFormName(1).Text & "' has been found" & Chr(10) & "in index entry" & Str(j) & ", " & Left(Buf, LenEntryText) & ".", 64, "Demo Copyright 1994 David Stewart"
'If we didn't find it in ANY part of the list box, let user know.
If IsStringIn = 0 Then
MsgBox "The string fragment '" & txtFormName(1).Text & "' has not been found" & Chr(10) & "in the Project window list.", 64, "Demo Copyright 1994 David Stewart"
End If
End If
Case 5 'Name and Index of Current Selection...
'Get the position currently selected in the list...